home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
crsbas.zip
/
CROSSBAS.INC
< prev
next >
Wrap
Text File
|
1990-12-01
|
14KB
|
423 lines
'┌─────────────────────────────────────────────────────────────────────┐
'└── beginning of crossbas.inc ────────────────────────────────────────┘
' Include file for CrossBas.bas
' Lester L. Noll
' CompuServe Id: 72250,2551
' copyright (c) November 13, 1989, 1990
'─── flush keyboard buffer ─────────────────────────────────────────────
SUB FlushKeyBuf 'Flush any waiting keystrokes.
WHILE INSTAT
InK$ =INKEY$
WEND
END SUB
'─── dimension cmd line array ──────────────────────────────────────────
SUB DimCmdLine(DimCmd%) 'Find number of elements in command line to dimension
' the parameter$ array of ReadCmdLine() procedure.
LOCAL I%, Char$, CmdLine$, DelimitFlag%
DimCmd% =0
DelimitFlag% =-1
CmdLine$=COMMAND$
FOR I% =1 TO LEN(CmdLine$) 'Increment through the cmd line 1 char at a time.
Char$=MID$(CmdLine$,I%,1)
SELECT CASE Char$
CASE " " : GOTO DimCmdLine.1 'Space char.
CASE "," : GOTO DimCmdLine.1 'Comma char.
CASE "/" : GOTO DimCmdLine.1 'Switch char.
CASE "" : GOTO DimCmdLine.1 'No more chars.
CASE CHR$(0) TO CHR$(31) : GOTO DimCmdLine.2 'Non-anphanumeric
CASE >CHR$(125) : GOTO DimCmdLine.2 'Non-alphanumeric
END SELECT
DelimitFlag% =0
GOTO DimCmdLine.2
DimCmdLine.1:
IF DelimitFlag% THEN DimCmdLine.2
DelimitFlag% =-1
INCR DimCmd%
DimCmdLine.2:
NEXT I%
INCR DimCmd%
END SUB
'─── read DOS command line ─────────────────────────────────────────────
SUB ParseCmdLine(Cmd$(1)) 'This subprogram will parse the DOS command line
' and return the non-blank characters as members
' of the array Cmd$(). The maximum number of
' command line characters is 127.
'If you expect to see more than 10 command line
' parameters, you must include a DIM Cmd$()
' statement prior to calling this subprogram.
'You should include a $DYNAMIC statement at the
' top of the calling program so that after you are
' finished with the Cmd$() array you can ERASE it.
LOCAL I%, J%, Char$, Temp$, CmdLine$, DelimitFlag%
DelimitFlag% =-1
CmdLine$=COMMAND$
FOR I% =1 TO LEN(CmdLine$)+1 'Increment through the cmd line 1 char at a time.
Char$=MID$(CmdLine$,I%,1)
SELECT CASE Char$
CASE " " : GOTO ParseCmdLine.6 'Space char.
CASE "," : GOTO ParseCmdLine.6 'Comma char.
CASE "" : GOTO ParseCmdLine.4 'No more chars.
CASE CHR$(0) TO CHR$(31) : GOTO ParseCmdLine.9 'Ignore non alpha-num.
CASE "/" : GOTO ParseCmdLine.5 'Switch delimiter.
CASE ELSE : GOTO ParseCmdLine.7
END SELECT
ParseCmdLine.4: 'No more chars on cmd line.
I% =128
GOTO ParseCmdLine.8
ParseCmdLine.5: 'Switch delimiter.
IF Temp$ ="/" GOTO ParseCmdLine.9
IF NOT (Temp$ ="") THEN ParseCmdLine.8
GOTO ParseCmdLine.7
ParseCmdLine.6: 'Space delimiter.
IF DelimitFlag% THEN ParseCmdLine.9
DelimitFlag% =-1
GOTO ParseCmdLine.8
ParseCmdLine.7: 'Normal text.
DelimitFlag% =0
Temp$ =Temp$ +Char$
GOTO ParseCmdLine.9
ParseCmdLine.8: 'Save word and start next.
INCR J%
Cmd$(J%) =Temp$
IF Char$ ="/" THEN Temp$ =Char$ ELSE Temp$ =""
ParseCmdLine.9: 'Get next character.
NEXT I%
END SUB
'─── calculate the drive portion of a file path ────────────────────────
SUB CalcDr(FilePath$,Dr$)
LOCAL C%
Dr$ =""
IF NOT (FilePath$ ="") THEN
C% =INSTR(FilePath$,":")
IF C% =2 THEN
SELECT CASE UCASE$(LEFT$(FilePath$,1))
CASE "A" TO "J" : Dr$ =LEFT$(FilePath$,2)
END SELECT
END IF
END IF
END SUB
'─── calculate the directory portion of a file path ────────────────────
SUB CalcDir(FilePath$,Dir$)
LOCAL I%, I1%, I2%
Dir$ =""
IF NOT FilePath$ ="" THEN
I% =INSTR(FilePath$,"\")
IF I% >0 THEN
I1% =I%
WHILE I% >0
I2% =I%
I% =INSTR(I2%+1,FilePath$,"\")
WEND
Dir$ =MID$(FilePath$,I1%,I2%-I1%+1)
END IF
IF NOT Dir$ ="" THEN
IF NOT LEFT$(Dir$,1) ="\" THEN Dir$ ="\" +Dir$
IF NOT RIGHT$(Dir$,1) ="\" THEN Dir$ =Dir$ +"\"
END IF
END IF
END SUB
'─── calculate the filename portion of a file path ─────────────────────
SUB CalcName(FilePath$,FileName$)
LOCAL C%, I%, I1%
FileName$ =""
IF NOT (FilePath$ ="") THEN
C% =INSTR(FilePath$,":")
IF NOT (C% =2) THEN C% =0
I% =INSTR(FilePath$,"\")
WHILE I% >0
I1% =I%
I% =INSTR(I%+1,FilePath$,"\")
WEND
IF I1% >0 THEN
FileName$ =MID$(FilePath$,I1%+1)
ELSEIF C% =2 THEN
FileName$ =MID$(FilePath$,3)
ELSE
FileName$ =FilePath$
END IF
END IF
END SUB
'─── catch runtime error ────────────────────────────────────────────────
SUB CatchRuntime
BEEP: DELAY 1: BEEP: DELAY 1: BEEP
PRINT
PRINT "Fatal Error Encountered!!"
PRINT
PRINT "Error #";STR$(ERR);" at PC counter ";
PRINT ERADR
PRINT fnErrorMsg$
IF ERDEV >0 THEN
PRINT "Device #";ERDEV$; ", "; STR$(ERDEV)
END IF
PRINT "End Memory =";
PRINT ENDMEM
PRINT "String Segment=";
Temp& =(VARSEG(S$))
Temp& =Temp&*16
PRINT Temp&,
PRINT "Hex: "; HEX$(VARSEG(S$));":";HEX$(VARPTR(S$))
PRINT "String Space =";
PRINT FRE(S$)
PRINT "Array Space =";
PRINT FRE(-1)
PRINT "Stack Space =";
PRINT FRE(-2)
END SUB
'─── get error description ─────────────────────────────────────────────
DEF fnErrorMsg$
LOCAL ErrNum%, Temp$
ErrNum% =ERR
SELECT CASE ErrNum%
CASE 0 : Temp$ =""
CASE 2 : Temp$ ="Syntax error"
CASE 3 : Temp$ ="RETURN without GOSUB"
CASE 4 : Temp$ ="Out of data"
CASE 5 : Temp$ ="Illegal functin call"
CASE 6 : Temp$ ="Overflow"
CASE 7 : Temp$ ="Out of memory"
CASE 9 : Temp$ ="Subscript out of range"
CASE 10 : Temp$ ="Duplicate definition"
CASE 11 : Temp$ ="Division by zero"
CASE 13 : Temp$ ="Type mismatch"
CASE 14 : Temp$ ="Out of string space"
CASE 15 : Temp$ ="String too long"
CASE 19 : Temp$ ="No RESUME"
CASE 20 : Temp$ ="RESUME without error"
CASE 24 : Temp$ ="Device Timeout"
CASE 25 : Temp$ ="Device hardware error"
CASE 27 : Temp$ ="Printer out of paper"
CASE 50 : Temp$ ="Field overflow"
CASE 51 : Temp$ ="Internal error"
CASE 52 : Temp$ ="Bad file number"
CASE 53 : Temp$ ="File not found"
CASE 54 : Temp$ ="Bad file mode"
CASE 55 : Temp$ ="File already open"
CASE 57 : Temp$ ="Device I/O error"
CASE 58 : Temp$ ="File already exists"
CASE 61 : Temp$ ="Disk is full"
CASE 62 : Temp$ ="Input past end"
CASE 63 : Temp$ ="Bad record number"
CASE 64 : Temp$ ="Bad file name"
CASE 67 : Temp$ ="Too many files in directory or bad file spec"
CASE 68 : Temp$ ="Device not available"
CASE 69 : Temp$ ="Communications buffer overflow"
CASE 70 : Temp$ ="Disk is write protected"
CASE 71 : Temp$ ="Disk not ready"
CASE 72 : Temp$ ="Disk media error"
CASE 74 : Temp$ ="Rename across disks"
CASE 75 :